home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 02 - 1986 / 02.10 Oct 86.sit / 02.10 Oct 86 / basic source / MSSample.bas (.txt) next >
Encoding:
AmigaBASIC Source Code  |  1986-09-04  |  3.0 KB  |  146 lines  |  [MSBC/MSBB]
  1. ' SAMPLE DEMO
  2. ' MacTutor©1986
  3. ' By Dave Kelly
  4.  
  5. DEFINT A-z
  6. LIBRARY "Samplelib"
  7. filerefnum%=0
  8. openresfile! "Ram Disk:System Folder:System",filerefnum%
  9. changecursor! 4
  10. DIM Font(127),Font$(127),Check(127),Pt(1),Rect(3),Sizecheck(6)
  11. hand!=0:id%=0:type$="FONT":A$="":x%=0
  12. fontstyle9=0:fontstyle10=0:fontstyle12=0
  13. fontstyle14=0:fontstyle18=0:fontstyle24=0
  14. Result=0
  15. X1=50:Y1=130:X2=460:Y2=240
  16. False=0:True=NOT False
  17. WINDOW 1,"Untitled",(X1,Y1)-(X2,Y2)
  18. MENU 1,0,1,"File"
  19. MENU 1,1,1,"New"
  20. MENU 1,2,1,"Open"
  21. MENU 1,3,1,"Close"
  22. MENU 1,4,1,"Save"
  23. MENU 1,5,1,"Save As..."
  24. MENU 1,6,1,"Quit"
  25. MENU 3,0,1,"Font"
  26. MENU 4,0,1,"Size"
  27. MENU 5,0,0,""
  28. GetFonts:
  29. ON ERROR GOTO 9000
  30. I=1
  31. FOR x%=0 TO 127
  32. GetIndRes! "FONT",x%,hand!
  33. GetResInfo! hand!,id%,type$,A$
  34. IF LEN(A$) THEN Font$(I)=A$:Font(I)=id%:I=I+1:A$="":id%=0
  35. 10 NEXT x%
  36. ON ERROR GOTO 0
  37. NumberofFonts=I-1
  38. SortString! NumberofFonts,Font$(1),Font(1)
  39. FOR J=1 TO NumberofFonts
  40. IF Font$(J)="Geneva" THEN Check(J)=2 :ELSE Check(J)=1
  41. IF Font$(J)="Geneva" THEN g=Font(I)/128
  42. MENU 3,J,Check(J),Font$(J)
  43. NEXT J
  44. REALFONT! g,9,fontstyle9
  45. REALFONT! g,10,fontstyle10
  46. REALFONT! g,12,fontstyle12
  47. REALFONT! g,14,fontstyle14
  48. REALFONT! g,18,fontstyle18
  49. REALFONT! g,24,fontstyle24
  50. FOR J=1 TO 6
  51. Sizecheck(J)=1
  52. NEXT J
  53. Sizecheck(3)=2
  54. GOSUB Fontsizemenu
  55. <0xca564e0,0xca54010> (2)
  56. <0xca56520,0xca54010> (12)
  57. ON MENU GOSUB menuevent
  58. MENU ON
  59. <0xca565e0,0xca54010>
  60. loop:
  61. Wx=WINDOW(2):Wy=WINDOW(3)
  62. SetRect! Rect(0),0,0,Wx,Wy
  63. x=MOUSE(0):Pt(1)=MOUSE(1):Pt(0)=MOUSE(2)
  64. PtInRect! Pt(0),Rect(0),Result
  65. IF Result=False THEN <0x1a,0xca54010> :ELSE changecursor! 1
  66. GOTO loop
  67. Fontsizemenu:
  68. MENU OFF
  69. MENU 4,1,Sizecheck(1),"9 Point":SetItemStyle! 4,1,0
  70. MENU 4,2,Sizecheck(2),"10 Point":SetItemStyle! 4,2,0
  71. MENU 4,3,Sizecheck(3),"12 Point":SetItemStyle! 4,3,0
  72. MENU 4,4,Sizecheck(4),"14 Point":SetItemStyle! 4,4,0
  73. MENU 4,5,Sizecheck(5),"18 Point":SetItemStyle! 4,5,0
  74. MENU 4,6,Sizecheck(6),"24 Point":SetItemStyle! 4,6,0
  75. IF fontstyle9   = True THEN SetItemStyle! 4,1,8
  76. IF fontstyle10 = True THEN SetItemStyle! 4,2,8
  77. IF fontstyle12 = True THEN SetItemStyle! 4,3,8
  78. IF fontstyle14 = True THEN SetItemStyle! 4,4,8
  79. IF fontstyle18 = True THEN SetItemStyle! 4,5,8
  80. IF fontstyle24 = True THEN SetItemStyle! 4,6,8
  81. MENU ON
  82. RETURN
  83. menuevent:
  84. Menunumber = MENU(0)
  85. Menuitem = MENU(1)
  86. MENU OFF:MENU
  87. ON Menunumber GOSUB File,Editmenu,Font,Size
  88. MENU ON
  89. RETURN
  90. File:
  91. ON Menuitem GOSUB Newitem,Openitem,Closeitem,Saveitem,SaveAs,Quit
  92. RETURN
  93. Editmenu:
  94. RETURN
  95. Font:
  96. FOR J=1 TO NumberofFonts
  97. Check(J)=1
  98. MENU 3,J,Check(J)
  99. NEXT J
  100. Check(Menuitem)=2
  101. MENU 3,Menuitem,Check(Menuitem)
  102. fontnum=Font(Menuitem)/128
  103. REALFONT! fontnum,9,fontstyle9
  104. REALFONT! fontnum,10,fontstyle10
  105. REALFONT! fontnum,12,fontstyle12
  106. REALFONT! fontnum,14,fontstyle14
  107. REALFONT! fontnum,18,fontstyle18
  108. REALFONT! fontnum,24,fontstyle24
  109. GOSUB Fontsizemenu
  110. CALL <0x2a,0xca54010> (Font(Menuitem)/128):' Font # is id%/128
  111. RETURN
  112. Size:
  113. FOR J=1 TO 6
  114. Sizecheck(J)=1:MENU 4,J,1
  115. NEXT J
  116. Sizecheck(Menuitem)= 2
  117. MENU 4,Menuitem,2
  118. IF Menuitem=1 THEN <0x12,0xca54010> (9)
  119. IF Menuitem=2 THEN <0x13,0xca54010> (10)
  120. IF Menuitem=3 THEN <0x13,0xca54010> (12)
  121. IF Menuitem=4 THEN <0x13,0xca54010> (14)
  122. IF Menuitem=5 THEN <0x13,0xca54010> (18)
  123. IF Menuitem=6 THEN <0x13,0xca54010> (24)
  124. RETURN
  125. Newitem:
  126. PRINT "New Selected"
  127. RETURN
  128. Openitem:
  129. PRINT "Open Selected"
  130. RETURN
  131. Closeitem:
  132. PRINT "Close Selected"
  133. RETURN
  134. Saveitem:
  135. PRINT "Save Selected"
  136. RETURN
  137. SaveAs:
  138. PRINT "SaveAs Selected"
  139. RETURN
  140. Quit:
  141. MENU RESET
  142. END
  143. 9000 changecursor! 4
  144. RESUME 10
  145. BEEP:PRINT "OOPS"
  146.